home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
bbsutil
/
bbs10.zip
/
BBS.TXT
< prev
next >
Wrap
Text File
|
1988-07-04
|
11KB
|
236 lines
1 dim bbsname$(25),col%(6,25),des$(6,25),cl%(6),ds$(6)
10 REM THIS PROGRAM MAINTAINS, UPDATES, AND SEARCHES THE DIRECTORYS OF
20 REM ALL BBS SERVICES YOU CHECK INTO.
100 cls
105 PRINT " BBS.BAS"
110 PRINT " Version - 1.0"
120 print " by: William L. Munson"
125 print " July 1, 1988"
130 print:print
140 print " OPTIONS MENU"
150 PRINT " ============
160 PRINT " (1) Search for string. "
170 print " (2) Add new BBS file to the data base."
180 print " (3) Update existing BBS data base."
190 print " (4) Delete BBS data base from list."
195 print " (5) Send list of files to printer."
200 print " (6) Quit and exit to DOS."
210 print : input "Enter option [1]:";optn$ 'optn$ - string with option #
220 if optn$="6" then close : system 'Exit to the operating systen
230 if optn$="1" then gosub 1000 'search for string
240 if optn$="2" then gosub 2000 'add new bbs
250 if optn$="3" then gosub 3000 'update data base
260 if optn$="4" then gosub 4000 'delete bbs
270 if optn$="" then gosub 1000 'also search for string
280 if optn$="5" then gosub 5000 'list of files to printer
999 goto 100
1000 'This section searches any one or all of the BBS files listed in BBSLIST.BBS
1010 close:cls:print" Search for string section."
1020 print:print
1030 print "LIST OF DIRECTORYS.":PRINT
1040 print "Number Name"
1045 print "-------------------------------"
1050 open "bbslist.bbs" for input as #2
1060 x=1
1070 input #2,BBSname$(x),Col%(1,x),des$(1,x),Col%(2,x),des$(2,x),Col%(3,x),des$(3,x),Col%(4,x),des$(4,x),Col%(5,x),des$(5,x)
1100 print x,BBSname$(x)
1110 if not eof(2) then x=x+1:goto 1070
1120 print:print "Enter number of directory or [RETURN] for all";
1130 input num$
1140 if num$="" then Start=1:stp=x:goto 1200
1150 if val(num$)>0 then start=val(num$):stp=val(num$) else beep:goto 1120
1200 print:print "Send output to (S)creen or (P)rinter";
1210 input Dev$
1300 print:input "Enter search string";strng$
1310 ucs$="":for z=1 to len(strng$):a=asc(mid$(strng$,z,1))
1320 if a>96 and a<123 then a=a-32
1330 ucs$=ucs$+chr$(a):next z
1350 if dev$="p" or dev$="P" then goto 1700
1400 'this section directs search results to the screen
1410 postn=1:Found=0:for count=start to stp
1415 open bbsname$(count) for input as #1:goto 1470
1420 cls:y=1:print "Listing of ";bbsname$(count);" for search string - ";strng$:print
1430 print tab(col%(y,count));des$(y,count);
1440 if col%(y,count)>0 then y=y+1 :goto 1430
1450 print "-------------------------------------------------------------------------------"
1460 Found=1:return
1470 if eof(1) then goto 1560
1480 line input #1,S$
1500 if instr(S$,ucs$)=0 then goto 1470
1510 if found=0 then gosub 1420
1520 print s$:postn=postn+1
1530 if postn=20 then input "Press [RETURN] to continue. ";dummy$:postn=1:gosub 1420
1550 goto 1470
1560 close #1 :if found=1 then input "--DONE-- Press [RETURN] to continue. ";dummy$:postn=1
1600 found=0:next count :return
1700 'this section directs search results to the printer
1710 input "Please ready printer to online status and press [RETURN] ";dummy$
1715 postn=1:found=0:for count=start to stp :goto 1760
1720 y=1:lprint "Listing of ";bbsname$(count);" for search string - ";strng$:lprint
1730 lprint tab(Col%(y,count));des$(y,count);
1740 if col%(y,count)>0 then y=y+1 :goto 1730
1750 lprint "-------------------------------------------------------------------------------"
1752 FOUND=1:postn=postn+4:return
1760 open bbsname$(count) for input as #1
1770 if eof(1) then goto 1860
1780 line input #1,S$
1800 if instr(s$,ucs$)=0 then goto 1770
1810 if found=0 then gosub 1720
1820 lprint s$:postn=postn+1
1830 if postn>=55 then lprint chr$(12):postn=1:gosub 1720
1850 goto 1770
1860 close #1:if found=1 then lprint:lprint:lprint:lprint:postn=postn+4:found=0
1900 next count:if postn>1 then lprint chr$(12)
1910 return
2000 ' this section inputs the catalog info from the ascii file and puts
2010 ' the info into records in a BBS file.
2020 cls:close:print " BBS new file input section.":print
2030 print "Please enter the filename of the ASCII file which contains the"
2040 print "file catalog data. (Note: File must not contain anything other"
2050 print "than the desired data.)
2060 print:print "The filename syntax is [filename.ext]."
2070 input "Enter the filename or (RETURN) to abort ";finme$
2080 if finme$="" then return 'checks for abort condition
2085 PosPeriod=instr(finme$,".")
2090 if (PosPeriod=0) or (PosPeriod>8) or (len(finme$)>12) then cls:goto 2030
2100 on error goto 2130
2110 open finme$ for input as #1
2120 on error goto 0:goto 2140 'must be valid file.
2130 print:print "File opening error !!!":resume 2060
2140 BBSname$=left$(finme$,PosPeriod-1)
2150 print:print "Is '";BBSname$;"' the name of the BBS system ([Y]/n) ";
2160 input correct$
2170 if correct$="" or correct$="Y" or correct$="y" then goto 2210
2180 input "Enter desired BBS filename (no extention) ";BBSname$
2190 if instr(BBSname$,".")>0 then print:print "No extention please!":goto 2180
2200 if len(BBSname$)>8 or len(BBSname$)=0 then print:print "Valid dos filenames only!":goto 2180
2210 'This section prints a header of column numbers and several lines of the
2220 'input file so that you can see where the field breaks are.
2230 cls
2240 print "1234567890123456789012345678901234567890123456789012345678901234567890123456789"
2250 for x=1 to 5
2260 line input #1, S$
2270 print s$
2280 next x
2290 print
2300 print "To define the data fields of the input file enter the column where the des-"
2310 print "cription starts, Comma, and a description of the field not longer then the"
2320 print "field itself. Start with the first field (left most) and finish with the right"
2330 print "most field (Then enter '79,' to end).":FieldNum=1
2340 input "Enter column, description ";Cl%(FieldNum),Ds$(FieldNum)
2350 if cl%(FieldNum)>=79 then cl%(FieldNum)=0 :goto 2380
2360 FieldNum=FieldNum+1
2370 goto 2340
2380 s$=bbsname$:gosub 2710:bbsname$=ucs$
2400 BBSname$=BBSname$+".BBS"
2410 open "BBSLIST.BBS" for append as #2
2420 write #2,BBSname$,Cl%(1),Ds$(1),Cl%(2),Ds$(2),Cl%(3),Ds$(3),Cl%(4),Ds$(4),Cl%(5),Ds$(5)
2560 for x=1 to 5
2570 cl%(x)=0
2580 Ds$(x)=""
2590 next x
2600 close:print:print "Please WAIT while I proccess the file."
2605 print "This will take a while!"
2610 open finme$ for input as #1
2620 open bbsname$ for output as #3
2630 if not eof(1) then line input #1,S$:gosub 2700:print #3,ucS$:goto 2630
2640 close
2650 print "Do you want ";finme$;" deleted (Y/N)";
2660 input aa$:if aa$="y" or aa$="Y" then kill finme$
2670 return
2700 'sub-routine to convert strings to all capital letters
2710 ucs$="":for z=1 to len(S$)
2720 a= asc(mid$(s$,z,1)):if a>96 and a<123 then a=a-32
2730 ucs$=ucs$+chr$(a):next z:return
3000 ' this section inputs the catalog update info from the ascii file and puts
3010 ' the info into a BBS file.
3020 cls:close:print " BBS file update section.":print
3030 print "Please enter the filename of the ASCII file which contains the"
3040 print "file update data. (Note: File must not contain anything other"
3050 print "than the desired data.)
3060 print:print "The filename syntax is [filename.ext]."
3070 input "Enter the filename or (RETURN) to abort ";finme$
3080 if finme$="" then return 'checks for abort condition
3085 PosPeriod=instr(finme$,".")
3090 if (PosPeriod=0) or (PosPeriod>8) or (len(finme$)>12) then cls:goto 3030
3100 on error goto 3130
3110 open finme$ for input as #1
3120 on error goto 0:goto 3140 'must be valid file.
3130 print:print "File opening error !!!":resume 3060
3140 cls
3150 print "LIST OF DIRECTORYS.":PRINT
3160 print "Number Name"
3170 print "-------------------------------"
3180 open "bbslist.bbs" for input as #2
3190 x=1
3200 input #2,BBSname$(x),Col%(1,x),des$(1,x),Col%(2,x),des$(2,x),Col%(3,x),des$(3,x),Col%(4,x),des$(4,x),Col%(5,x